<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"><html xmlns="http://www.w3.org/1999/xhtml"><head><link rel="stylesheet" type="text/css" href="style.css" /><script type="text/javascript" src="highlight.js"></script></head><body><pre><span class="hs-pragma">{-# LANGUAGE CPP #-}</span><span>
</span><span id="line-2"></span><span class="hs-comment">{- |
   Module      :  System.Win32.HardLink
   Copyright   :  2013 shelarcy
   License     :  BSD-style

   Maintainer  :  shelarcy@gmail.com
   Stability   :  Provisional
   Portability :  Non-portable (Win32 API)

   Handling hard link using Win32 API. [NTFS only]

   Note: You should worry about file system type when use this module's function in your application:

     * NTFS only supprts this functionality.

     * ReFS doesn't support hard link currently.
-}</span><span>
</span><span id="line-19"></span><span class="hs-keyword">module</span><span> </span><span class="hs-identifier">System.Win32.HardLink</span><span>
</span><span id="line-20"></span><span>  </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="System.Win32.HardLink.html#createHardLink"><span class="hs-identifier">createHardLink</span></a></span><span>
</span><span id="line-21"></span><span>  </span><span class="hs-special">,</span><span> </span><span class="annot"><a href="System.Win32.HardLink.html#createHardLink%27"><span class="hs-identifier">createHardLink'</span></a></span><span>
</span><span id="line-22"></span><span>  </span><span class="hs-special">)</span><span> </span><span class="hs-keyword">where</span><span>
</span><span id="line-23"></span><span>
</span><span id="line-24"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="System.Win32.File.html"><span class="hs-identifier">System.Win32.File</span></a></span><span>   </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="System.Win32.File.html#LPSECURITY_ATTRIBUTES"><span class="hs-identifier">LPSECURITY_ATTRIBUTES</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="System.Win32.File.html#failIfFalseWithRetry_"><span class="hs-identifier">failIfFalseWithRetry_</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-25"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="System.Win32.String.html"><span class="hs-identifier">System.Win32.String</span></a></span><span> </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="System.Win32.Types.html#LPCTSTR"><span class="hs-identifier">LPCTSTR</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="System.Win32.Types.html#withTString"><span class="hs-identifier">withTString</span></a></span><span> </span><span class="hs-special">)</span><span>
</span><span id="line-26"></span><span class="hs-keyword">import</span><span> </span><span class="annot"><a href="System.Win32.Types.html"><span class="hs-identifier">System.Win32.Types</span></a></span><span>  </span><span class="hs-special">(</span><span> </span><span class="annot"><a href="System.Win32.Types.html#BOOL"><span class="hs-identifier">BOOL</span></a></span><span class="hs-special">,</span><span> </span><span class="annot"><a href="../../base/src/GHC.Ptr.html#nullPtr"><span class="hs-identifier">nullPtr</span></a></span><span> </span><span class="hs-special">)</span><span class="hs-cpp">

#include &quot;windows_cconv.h&quot;
</span><span>
</span><span id="line-30"></span><span class="hs-comment">-- | NOTE: createHardLink is /flipped arguments/ to provide compatibility for Unix.</span><span>
</span><span id="line-31"></span><span class="hs-comment">-- </span><span>
</span><span id="line-32"></span><span class="hs-comment">-- If you want to create hard link by Windows way, use 'createHardLink'' instead.</span><span>
</span><span id="line-33"></span><span class="annot"><a href="System.Win32.HardLink.html#createHardLink"><span class="hs-identifier hs-type">createHardLink</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="../../base/src/GHC.IO.html#FilePath"><span class="hs-identifier hs-type">FilePath</span></a></span><span> </span><span class="hs-comment">-- ^ Target file path</span><span>
</span><span id="line-34"></span><span>               </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="../../base/src/GHC.IO.html#FilePath"><span class="hs-identifier hs-type">FilePath</span></a></span><span> </span><span class="hs-comment">-- ^ Hard link name</span><span>
</span><span id="line-35"></span><span>               </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="hs-identifier hs-type">IO</span></span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-36"></span><span id="createHardLink"><span class="annot"><span class="annottext">createHardLink :: FilePath -&gt; FilePath -&gt; IO ()
</span><a href="System.Win32.HardLink.html#createHardLink"><span class="hs-identifier hs-var hs-var">createHardLink</span></a></span></span><span> </span><span class="hs-glyph">=</span><span> </span><span class="annot"><span class="annottext">(FilePath -&gt; FilePath -&gt; IO ()) -&gt; FilePath -&gt; FilePath -&gt; IO ()
forall a b c. (a -&gt; b -&gt; c) -&gt; b -&gt; a -&gt; c
</span><a href="../../base/src/GHC.Base.html#flip"><span class="hs-identifier hs-var">flip</span></a></span><span> </span><span class="annot"><span class="annottext">FilePath -&gt; FilePath -&gt; IO ()
</span><a href="System.Win32.HardLink.html#createHardLink%27"><span class="hs-identifier hs-var">createHardLink'</span></a></span><span>
</span><span id="line-37"></span><span>
</span><span id="line-38"></span><span class="annot"><a href="System.Win32.HardLink.html#createHardLink%27"><span class="hs-identifier hs-type">createHardLink'</span></a></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="../../base/src/GHC.IO.html#FilePath"><span class="hs-identifier hs-type">FilePath</span></a></span><span> </span><span class="hs-comment">-- ^ Hard link name</span><span>
</span><span id="line-39"></span><span>                </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="../../base/src/GHC.IO.html#FilePath"><span class="hs-identifier hs-type">FilePath</span></a></span><span> </span><span class="hs-comment">-- ^ Target file path</span><span>
</span><span id="line-40"></span><span>                </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="hs-identifier hs-type">IO</span></span><span> </span><span class="hs-special">(</span><span class="hs-special">)</span><span>
</span><span id="line-41"></span><span id="createHardLink%27"><span class="annot"><span class="annottext">createHardLink' :: FilePath -&gt; FilePath -&gt; IO ()
</span><a href="System.Win32.HardLink.html#createHardLink%27"><span class="hs-identifier hs-var hs-var">createHardLink'</span></a></span></span><span> </span><span id="local-6989586621679114990"><span class="annot"><span class="annottext">FilePath
</span><a href="#local-6989586621679114990"><span class="hs-identifier hs-var">link</span></a></span></span><span> </span><span id="local-6989586621679114989"><span class="annot"><span class="annottext">FilePath
</span><a href="#local-6989586621679114989"><span class="hs-identifier hs-var">target</span></a></span></span><span> </span><span class="hs-glyph">=</span><span>
</span><span id="line-42"></span><span>   </span><span class="annot"><span class="annottext">FilePath -&gt; (LPTSTR -&gt; IO ()) -&gt; IO ()
forall a. FilePath -&gt; (LPTSTR -&gt; IO a) -&gt; IO a
</span><a href="System.Win32.Types.html#withTString"><span class="hs-identifier hs-var">withTString</span></a></span><span> </span><span class="annot"><span class="annottext">FilePath
</span><a href="#local-6989586621679114989"><span class="hs-identifier hs-var">target</span></a></span><span> </span><span class="annot"><span class="annottext">((LPTSTR -&gt; IO ()) -&gt; IO ()) -&gt; (LPTSTR -&gt; IO ()) -&gt; IO ()
forall a b. (a -&gt; b) -&gt; a -&gt; b
</span><a href="../../base/src/GHC.Base.html#%24"><span class="hs-operator hs-var">$</span></a></span><span> </span><span class="hs-glyph">\</span><span id="local-6989586621679114988"><span class="annot"><span class="annottext">LPTSTR
</span><a href="#local-6989586621679114988"><span class="hs-identifier hs-var">c_target</span></a></span></span><span> </span><span class="hs-glyph">-&gt;</span><span>
</span><span id="line-43"></span><span>   </span><span class="annot"><span class="annottext">FilePath -&gt; (LPTSTR -&gt; IO ()) -&gt; IO ()
forall a. FilePath -&gt; (LPTSTR -&gt; IO a) -&gt; IO a
</span><a href="System.Win32.Types.html#withTString"><span class="hs-identifier hs-var">withTString</span></a></span><span> </span><span class="annot"><span class="annottext">FilePath
</span><a href="#local-6989586621679114990"><span class="hs-identifier hs-var">link</span></a></span><span>   </span><span class="annot"><span class="annottext">((LPTSTR -&gt; IO ()) -&gt; IO ()) -&gt; (LPTSTR -&gt; IO ()) -&gt; IO ()
forall a b. (a -&gt; b) -&gt; a -&gt; b
</span><a href="../../base/src/GHC.Base.html#%24"><span class="hs-operator hs-var">$</span></a></span><span> </span><span class="hs-glyph">\</span><span id="local-6989586621679114987"><span class="annot"><span class="annottext">LPTSTR
</span><a href="#local-6989586621679114987"><span class="hs-identifier hs-var">c_link</span></a></span></span><span> </span><span class="hs-glyph">-&gt;</span><span>
</span><span id="line-44"></span><span>        </span><span class="annot"><span class="annottext">FilePath -&gt; IO Bool -&gt; IO ()
</span><a href="System.Win32.File.html#failIfFalseWithRetry_"><span class="hs-identifier hs-var">failIfFalseWithRetry_</span></a></span><span> </span><span class="hs-special">(</span><span class="annot"><span class="annottext">[FilePath] -&gt; FilePath
</span><a href="../../base/src/Data.OldList.html#unwords"><span class="hs-identifier hs-var">unwords</span></a></span><span> </span><span class="hs-special">[</span><span class="annot"><span class="annottext">FilePath
</span><span class="hs-string">&quot;CreateHardLinkW&quot;</span></span><span class="hs-special">,</span><span class="annot"><span class="annottext">FilePath -&gt; FilePath
forall a. Show a =&gt; a -&gt; FilePath
</span><a href="../../base/src/GHC.Show.html#show"><span class="hs-identifier hs-var">show</span></a></span><span> </span><span class="annot"><span class="annottext">FilePath
</span><a href="#local-6989586621679114990"><span class="hs-identifier hs-var">link</span></a></span><span class="hs-special">,</span><span class="annot"><span class="annottext">FilePath -&gt; FilePath
forall a. Show a =&gt; a -&gt; FilePath
</span><a href="../../base/src/GHC.Show.html#show"><span class="hs-identifier hs-var">show</span></a></span><span> </span><span class="annot"><span class="annottext">FilePath
</span><a href="#local-6989586621679114989"><span class="hs-identifier hs-var">target</span></a></span><span class="hs-special">]</span><span class="hs-special">)</span><span> </span><span class="annot"><span class="annottext">(IO Bool -&gt; IO ()) -&gt; IO Bool -&gt; IO ()
forall a b. (a -&gt; b) -&gt; a -&gt; b
</span><a href="../../base/src/GHC.Base.html#%24"><span class="hs-operator hs-var">$</span></a></span><span>
</span><span id="line-45"></span><span>          </span><span class="annot"><span class="annottext">LPTSTR -&gt; LPTSTR -&gt; LPSECURITY_ATTRIBUTES -&gt; IO Bool
</span><a href="System.Win32.HardLink.html#c_CreateHardLink"><span class="hs-identifier hs-var">c_CreateHardLink</span></a></span><span> </span><span class="annot"><span class="annottext">LPTSTR
</span><a href="#local-6989586621679114987"><span class="hs-identifier hs-var">c_link</span></a></span><span> </span><span class="annot"><span class="annottext">LPTSTR
</span><a href="#local-6989586621679114988"><span class="hs-identifier hs-var">c_target</span></a></span><span> </span><span class="annot"><span class="annottext">LPSECURITY_ATTRIBUTES
forall a. Ptr a
</span><a href="../../base/src/GHC.Ptr.html#nullPtr"><span class="hs-identifier hs-var">nullPtr</span></a></span><span>
</span><span id="line-46"></span><span>
</span><span id="line-47"></span><span class="hs-keyword">foreign</span><span> </span><span class="hs-keyword">import</span><span> </span><span class="hs-identifier">WINDOWS_CCONV</span><span> </span><span class="hs-keyword">unsafe</span><span> </span><span class="hs-string">&quot;windows.h CreateHardLinkW&quot;</span><span>
</span><span id="line-48"></span><span>  </span><span id="c_CreateHardLink"><span class="annot"><a href="System.Win32.HardLink.html#c_CreateHardLink"><span class="hs-identifier hs-var">c_CreateHardLink</span></a></span></span><span> </span><span class="hs-glyph">::</span><span> </span><span class="annot"><a href="System.Win32.Types.html#LPCTSTR"><span class="hs-identifier hs-type">LPCTSTR</span></a></span><span> </span><span class="hs-comment">-- ^ Hard link name</span><span>
</span><span id="line-49"></span><span>                   </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="System.Win32.Types.html#LPCTSTR"><span class="hs-identifier hs-type">LPCTSTR</span></a></span><span> </span><span class="hs-comment">-- ^ Target file path</span><span>
</span><span id="line-50"></span><span>                   </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><a href="System.Win32.File.html#LPSECURITY_ATTRIBUTES"><span class="hs-identifier hs-type">LPSECURITY_ATTRIBUTES</span></a></span><span> </span><span class="hs-comment">-- ^ This parameter is reserved. You should pass just /nullPtr/.</span><span>
</span><span id="line-51"></span><span>                   </span><span class="hs-glyph">-&gt;</span><span> </span><span class="annot"><span class="hs-identifier hs-type">IO</span></span><span> </span><span class="annot"><a href="System.Win32.Types.html#BOOL"><span class="hs-identifier hs-type">BOOL</span></a></span><span>
</span><span id="line-52"></span><span>
</span><span id="line-53"></span><span class="hs-comment">{-
-- We plan to check file system type internally.

-- We are thinking about API design, currently...
data VolumeInformation = VolumeInformation
      { volumeName         :: String
      , volumeSerialNumber :: DWORD
      , maximumComponentLength :: DWORD
      , fileSystemFlags    :: DWORD
      , fileSystemName     :: String
      } deriving Show

getVolumeInformation :: Maybe String -&gt; IO VolumeInformation
getVolumeInformation drive =
   maybeWith withTString drive $ \c_drive -&gt;
   withTStringBufferLen 256    $ \(vnBuf, vnLen) -&gt;
   alloca $ \serialNum -&gt;
   alloca $ \maxLen -&gt;
   alloca $ \fsFlags -&gt;
   withTStringBufferLen 256 $ \(fsBuf, fsLen) -&gt; do
       failIfFalse_ (unwords [&quot;GetVolumeInformationW&quot;, drive]) $
         c_GetVolumeInformation c_drive vnBuf (fromIntegral vnLen)
                                serialNum maxLen fsFlags
                                fsBuf (fromIntegral fsLen)
       return VolumeInformation
         &lt;*&gt; peekTString vnBuf
         &lt;*&gt; peek serialNum
         &lt;*&gt; peek maxLen
         &lt;*&gt; peek fsFlags
         &lt;*&gt; peekTString fsBuf

-- Which is better?
getVolumeFileType :: String -&gt; IO String
getVolumeFileType drive = fileSystemName &lt;$&gt; getVolumeInformation drive

getVolumeFileType :: String -&gt; IO String
getVolumeFileType drive =
   withTString drive        $ \c_drive -&gt;
   withTStringBufferLen 256 $ \(buf, len) -&gt; do
       failIfFalse_ (unwords [&quot;GetVolumeInformationW&quot;, drive]) $
         c_GetVolumeInformation c_drive nullPtr 0 nullPtr nullPtr nullPtr buf (fromIntegral len)
       peekTString buf

foreign import WINDOWS_CCONV unsafe &quot;windows.h GetVolumeInformationW&quot;
  c_GetVolumeInformation :: LPCTSTR -&gt; LPTSTR -&gt; DWORD -&gt; LPDWORD -&gt; LPDWORD -&gt; LPDWORD -&gt; LPTSTR -&gt; DWORD -&gt; IO BOOL
-}</span><span>
</span><span id="line-99"></span></pre></body></html>